home *** CD-ROM | disk | FTP | other *** search
/ Magnum One / Magnum One (Mid-American Digital) (Disc Manufacturing).iso / d12 / v9n21.arc / PRISM.INC < prev    next >
Text File  |  1990-11-17  |  57KB  |  1,703 lines

  1. { ========================================================================= }
  2. { PRISM.INC                                                                 }
  3. { ========================================================================= }
  4. { NoVga =================================================================== }
  5.  
  6. PROCEDURE NoVga;
  7.  
  8. BEGIN
  9.   WryteLn (ProgramName + ' is capable of setting each of the 16 attributes');
  10.   WryteLn ('of the VGA text mode display to any of 262,144 different colors.');
  11.   WryteLn ('It requires a computer with a VGA card and a compatible monitor.');
  12.   WryteLn ('');
  13.   textcolor (colormono (lightred, white));
  14.   WryteLn ('Sorry.  This system is not running a VGA display.');
  15.   halt;
  16. END;
  17.  
  18. { NoBw ==================================================================== }
  19.  
  20. PROCEDURE NoBw;
  21.  
  22. BEGIN
  23.   WryteLn (ProgramName + ' is capable of setting each of the 16 attributes');
  24.   WryteLn ('of the VGA text mode display to any of 262,144 different colors.');
  25.   WryteLn ('');
  26.   textcolor (colormono (lightred, white));
  27.   WryteLn ('Sorry.  It cannot be run in monochrome mode.');
  28.   halt;
  29. END;
  30.  
  31. { VgaRegisterOb.Accept ==================================================== }
  32.  
  33. PROCEDURE VgaRegisterOb.Accept (Num, Rval, Gval, Bval : byte);
  34.  
  35. BEGIN
  36.   With ColorValues do begin
  37.     ColorNumber := Num;
  38.     EgaReg := EgaPal [ColorNumber];
  39.     R := Rval;
  40.     G := Gval;
  41.     B := Bval;
  42.  
  43.     Saturation := 63 - min (R, min (G, B));      { saturation }
  44.     Intensity := max (R, max (G, B));            { intensity }
  45.  
  46.     Rreal := R;
  47.     Greal := G;
  48.     Breal := B;
  49.     end;
  50. END;
  51.  
  52. { VgaRegisterOb.Get ======================================================= }
  53.  
  54. PROCEDURE VgaRegisterOb.Get (Color : byte);
  55.  
  56. BEGIN
  57.   With ColorValues do begin
  58.     ColorNumber := Color;
  59.     EgaReg := EgaPal [ColorNumber];
  60.     GetVgaRegister (EgaReg, R, G, B);
  61.  
  62.     Saturation := 63 - min (R, min (G, B));      { saturation }
  63.     Intensity := max (R, max (G, B));            { intensity }
  64.  
  65.     Rreal := R;
  66.     Greal := G;
  67.     Breal := B;
  68.     end;
  69. END;
  70.  
  71. { VgaRegisterOb.GetSaturation ============================================= }
  72.  
  73. PROCEDURE VgaRegisterOb.GetSaturation (Color : byte);
  74.  
  75. BEGIN
  76.   With ColorValues do begin
  77.     Get (Color);
  78.     if Saturation > 0 then begin
  79.       Rstep := (63 - R)/Saturation;              { step size }
  80.       Gstep := (63 - G)/Saturation;
  81.       Bstep := (63 - B)/Saturation;
  82.       end
  83.     else begin
  84.       Rstep := 1;                                { step size }
  85.       Gstep := 1;
  86.       Bstep := 1;
  87.       end;
  88.     end;
  89. END;
  90.  
  91. { VgaRegisterOb.GetIntensity ============================================== }
  92.  
  93. PROCEDURE VgaRegisterOb.GetIntensity (Color : byte);
  94.  
  95. BEGIN
  96.   With ColorValues do begin
  97.     Get (Color);
  98.     if Intensity > 0 then begin
  99.       Rstep := R/Intensity;                      { step size }
  100.       Gstep := G/Intensity;
  101.       Bstep := B/Intensity;
  102.       end
  103.     else begin
  104.       Rstep := 1;                                { step size }
  105.       Gstep := 1;
  106.       Bstep := 1;
  107.       end;
  108.     end;
  109. END;
  110.  
  111. { VgaRegisterOb.Put ======================================================= }
  112.  
  113. PROCEDURE VgaRegisterOb.Put;
  114.  
  115. BEGIN
  116.   With ColorValues do begin
  117.     R := round (Rreal);
  118.     G := round (Greal);
  119.     B := round (Breal);
  120.     Saturation := 63 - min (R, min (G, B));      { saturation }
  121.     Intensity := max (R, max (G, B));            { intensity }
  122.     SetVgaRegister (EgaReg, R, G, B);
  123.     end;
  124. END;
  125.  
  126. { VgaRegisterOb.SetSaturation ============================================= }
  127.  
  128. PROCEDURE VgaRegisterOb.SetSaturation (Vector : integer);
  129.  
  130. BEGIN
  131.   With ColorValues do begin
  132.     repeat
  133.       Rreal := Rreal + Rstep * Vector;
  134.       Greal := Greal + Gstep * Vector;
  135.       Breal := Breal + Bstep * Vector;
  136.     until
  137.       (round (Rreal) <> R) or (round (Greal) <> G) or (round (Breal) <> B);
  138.     Put;
  139.     end;
  140. END;
  141.  
  142. { VgaRegisterOb.SetIntensity ============================================== }
  143.  
  144. PROCEDURE VgaRegisterOb.SetIntensity (Vector : integer);
  145.  
  146. BEGIN
  147.   With ColorValues do begin
  148.     repeat
  149.       Rreal := Rreal + Rstep * Vector;
  150.       Greal := Greal + Gstep * Vector;
  151.       Breal := Breal + Bstep * Vector;
  152.     until
  153.       (round (Rreal) <> R) or (round (Greal) <> G) or (round (Breal) <> B);
  154.     Put;
  155.     end;
  156. END;
  157.  
  158. { ========================================================================= }
  159. { VgaPaletteOb.Init ======================================================= }
  160.  
  161. PROCEDURE VgaPaletteOb.Init;
  162. VAR Loop : byte;
  163. BEGIN
  164.  
  165.   Get;                                           { P = current palette }
  166.   MaxYank := 15;                                 { how many to store }
  167.   Ctr := 0;
  168.   for Loop := 0 to MaxYank do                    { fill stack with P }
  169.     Stack [Loop] := StoreVgaPal;
  170.  
  171. END;
  172.  
  173. { VgaPaletteOb.Push ======================================================= }
  174.  
  175. PROCEDURE VgaPaletteOb.Push;
  176. { Store deleted palette on stack }
  177.  
  178. BEGIN
  179.   { if current palette is not most recently stored palette ... }
  180.   if
  181.     CompStruct (Stack [Ctr], P, sizeof (VgaRegArray)) <> equal
  182.   then begin
  183.     UpCycle (Ctr, 0, MaxYank);                   { increment counter }
  184.     Stack [Ctr] := P;                            { store on top of stack }
  185.     end;
  186. END;
  187.  
  188. { VgaPaletteOb.Pop ======================================================== }
  189.  
  190. PROCEDURE VgaPaletteOb.Pop (VAR Palette : VgaRegArray);
  191. { Retrieve deleted palette from stack }
  192.  
  193. VAR
  194.   Loop : byte;
  195.  
  196. BEGIN
  197.   Loop := 0;
  198.   While
  199.     (CompStruct (Stack [Ctr], P, sizeof (VgaRegArray)) = equal)
  200.       and
  201.     (Loop <= MaxYank)
  202.   do begin
  203.     DownCycle (Ctr, 0, MaxYank);
  204.     inc (Loop);
  205.     end;
  206.  
  207.   Palette := Stack [Ctr];                        { pop most recent palette }
  208.   Stack [Ctr] := P;                              { store P at new bottom }
  209.   DownCycle (Ctr, 0, MaxYank);                   { decrement counter }
  210. END;
  211.  
  212. { VgaPaletteOb.Get ======================================================== }
  213.  
  214. PROCEDURE VgaPaletteOb.Get;
  215. BEGIN
  216.   GetVgaPalette (P);
  217. END;
  218.  
  219. { VgaPaletteOb.Put ======================================================== }
  220.  
  221. PROCEDURE VgaPaletteOb.Put;
  222. BEGIN
  223.   SetVgaPalette (P);                             { P is the new palette }
  224.   Push;                                          { push it onto stack }
  225. END;
  226.  
  227. { VgaPaletteOb.Swap ======================================================= }
  228.  
  229. PROCEDURE VgaPaletteOb.Swap (Source, Target : byte);
  230. VAR
  231.   Loop : byte;
  232.   SwapPal : VgaRegArray;
  233. BEGIN
  234.   SwapPal := P;
  235.   for Loop := 1 to 3 do begin
  236.     P [Source, Loop] :=
  237.       SwapPal [Target, Loop];
  238.     P [Target, Loop ] :=
  239.       SwapPal [Source, Loop];
  240.     end;  { loop }
  241.   Put;
  242. END;
  243.  
  244. { VgaPaletteOb.Dupe ======================================================= }
  245.  
  246. PROCEDURE VgaPaletteOb.Dupe (Source, Target : byte);
  247. VAR
  248.   Loop : byte;
  249. BEGIN
  250.   for Loop := 1 to 3 do
  251.     P [Target, Loop] := P [Source, Loop];
  252.   Put;
  253. END;
  254.  
  255. { VgaPaletteOb.SetRGB ===================================================== }
  256.  
  257. PROCEDURE VgaPaletteOb.SetRGB (ColorNumber, Color, Value : byte);
  258.  
  259. BEGIN
  260.  
  261.   P [ColorNumber, Color] := Value;
  262.   SetVgaRegister (EgaPal [ColorNumber],
  263.                   P [ColorNumber, 1],
  264.                   P [ColorNumber, 2],
  265.                   P [ColorNumber, 3]);
  266.  
  267. END;
  268.  
  269. { VgaPaletteOb.DissolveTo ================================================= }
  270.  
  271. PROCEDURE VgaPaletteOb.DissolveTo (NewPal : VgaRegArray);
  272. { change to a new palette }
  273.  
  274. BEGIN
  275.   Dissolve (P, NewPal);                          { go from current to new }
  276.   P := NewPal;                                   { new is now current }
  277.   Push;                                          { store it on stack }
  278. END;
  279.  
  280. { ========================================================================= }
  281. { ResetDefaults =========================================================== }
  282.  
  283. PROCEDURE ResetDefaults;
  284.  
  285. BEGIN
  286. {
  287.   If no Config file, then clone the EXE file.
  288. }
  289.   if not ExistAnyFile (ConfigFileName) then 
  290.     if CloneArranger.InitCustom (ExeFileName, UpdateAll, DefBufSize) then begin
  291.       if CloneArranger.FindDefaultsEnd (Id, SizeOf (Id), 0) then begin 
  292.  
  293.         { write new values }
  294.         CloneArranger.StoreDefaults (CloneArranger.GetPos,
  295.                                      Id,
  296.                                      Ofs (CfgEnd) - Ofs (Id));
  297.         { check for errors }
  298.         if CloneArranger.GetLastError = 0 then begin
  299.           CloneArranger.Done;                    { close the EXE file }
  300.           exit;
  301.           end;
  302.         end;
  303.  
  304.       { Oops, can't clone the EXE file. }
  305.       CloneArranger.Done;                        { close the EXE file }
  306.       end;
  307.  
  308. {
  309.   Can't clone EXE file, so write to ConfigFile. 
  310. }
  311.   Rewrite (ConfigFile, sizeof (Block));          { write to config file }
  312.   BlockWrite (ConfigFile, Block, 1);
  313.   Close (ConfigFile);
  314. END;
  315.  
  316. { SliderSound ============================================================= }
  317.  
  318. PROCEDURE SliderSound;
  319. VAR
  320.   S          : string;
  321.   Loop       : byte;
  322. BEGIN
  323.   if not Sfx (SfxCues) then exit;
  324.   FastRead (80, SliderOption + SaturationLine, 1, S);
  325.   Case SliderOption of
  326.     0    : Loop := Pos (SaturationChar, S);
  327.     1..3 : Loop := Pos (SliderChar, S);
  328.     4    : Loop := Pos (IntensityChar, S);
  329.     end;
  330.   sound (Loop * 100);
  331. END;
  332.  
  333. { SliderBeep ============================================================== }
  334.  
  335. PROCEDURE SliderBeep;
  336. VAR
  337.   Loop : byte;
  338. BEGIN
  339.   if not Sfx (SfxCues) then exit;
  340.   SliderSound;
  341.   delay (3);
  342.   Loop := 0;
  343.   repeat
  344.     inc (Loop)
  345.   until
  346.     (Loop = 50)
  347.       or
  348.     KeyOrButtonPressed;
  349.   nosound;
  350. END;
  351.  
  352. { DrawAttributeBox ======================================================== }
  353.  
  354. PROCEDURE DrawAttributeBox (ColorNumber : byte);
  355. CONST
  356.   S : string [10] = ' ' +
  357.                     BxChar + BxChar + BxChar + BxChar +
  358.                     BxChar + BxChar + BxChar + BxChar + ' ';
  359.  
  360. VAR
  361.   Loop : byte;
  362. BEGIN
  363.   for Loop := 1 to 4 do
  364.     FastWrite (S,                                               { string }
  365.                trunc (1 + ((ColorNumber div 8) * 5)) + Loop,    { row }
  366.                succ ((ColorNumber mod 8) * 10),                 { column }
  367.                ColorNumber);                                    { attr }
  368. END;
  369.  
  370. { QuickStr ================================================================ }
  371.  
  372. FUNCTION QuickStr (V : byte) : string;           { formatted num to str }
  373. BEGIN
  374.   Write (TpStr, V:2);
  375.   QuickStr := ReturnStr;
  376. END;
  377.  
  378. { QuickMark =============================================================== }
  379.  
  380. FUNCTION QuickMark (M : string;  V : byte;  S : char) : string;
  381. VAR
  382.   MeterString : string [70];
  383.   Mark : string [3];
  384.  
  385. BEGIN
  386.   Mark := ^A + S + ^A;
  387.   MeterString := M;                              { string with mark }
  388.   Insert (Mark, MeterString, V + 2);
  389.   QuickMark := MeterString;
  390. END;
  391.  
  392. { ShowKernel ============================================================== }
  393.  
  394. PROCEDURE ShowKernel (Vgr : VgaRegisterOb);
  395. { Writes stars and bars. }
  396. CONST
  397.   Fattrs : FlexAttrs = (Black, White, Green, Blue);
  398. VAR
  399.   Loop   : byte;
  400.  
  401. BEGIN
  402.   if (CurrentColor = Black) or (CurrentColor = White) then
  403.     Fattrs [0] := LightGray
  404.   else
  405.     Fattrs [0] := CurrentColor;
  406.  
  407.   HideMouse;
  408.   With Vgr, ColorValues do begin
  409.     MeterString2 [1] := #201;                              { top }
  410.     MeterString2 [65] := #187;
  411.     FlexWrite (QuickMark (MeterString2, Saturation, SaturationChar),
  412.                SaturationLine, 12, Fattrs);
  413.  
  414.     FlexWrite (QuickMark (MeterString1, R, SliderChar),
  415.                RedLine, 12, Fattrs);                       { red }
  416.     FlexWrite (QuickMark (MeterString1, G, SliderChar),
  417.                GreenLine, 12, Fattrs);                     { green }
  418.     FlexWrite (QuickMark (MeterString1, B, SliderChar),
  419.                BlueLine, 12, Fattrs);                      { blue }
  420.  
  421.     { show actual number values }
  422.     For Loop := 0 to 4 do
  423.       FastWrite (QuickStr (ValArray [Loop]),
  424.                  SaturationLine + Loop, 79, White);
  425.  
  426.     MeterString2 [1] := #200;                              { bottom }
  427.     MeterString2 [65] := #188;
  428.     FlexWrite (QuickMark (MeterString2, Intensity, IntensityChar),
  429.                IntensityLine, 12, Fattrs);
  430.     end;
  431.   ShowMouse;
  432. END;
  433.  
  434. { ShowPercentages ========================================================= }
  435.  
  436. PROCEDURE ShowPercentages (ColorNum : byte);
  437. { Shows percentages of particular color. }
  438. VAR
  439.   Vgr : VgaRegisterOb;
  440.  
  441. BEGIN
  442.   With Pal do
  443.     Vgr.Accept (ColorNum, P [ColorNum, 1], P [ColorNum, 2], P [ColorNum, 3]);
  444.   ShowKernel (Vgr);
  445. END;
  446.  
  447. { SlidePercentages ======================================================== }
  448.  
  449. {$F+} PROCEDURE SlidePercentages; {$F-}
  450. { Shows percentage of CurrentColor.  Slides during dissolves. }
  451.  
  452. VAR
  453.   Vgr : VgaRegisterOb;
  454.  
  455. BEGIN
  456.   Vgr.Get (CurrentColor);
  457.   ShowKernel (Vgr);
  458. END;
  459.  
  460. { DrawBox ================================================================= }
  461.  
  462. PROCEDURE DrawBox;
  463. CONST
  464.   BoxTop         : string [11] = #201#205#205#205#205#205#205#205#205#187;
  465.   BoxSide        : string [4]  = #186#186#186#186;
  466.   BoxBottom      : string [11] = #200#205#205#205#205#205#205#205#205#188;
  467.   EmptyBoxTop    : string [11] = '          ';
  468.   EmptyBoxSide   : string [4]  = '    ';
  469.  
  470. VAR
  471.   TopRow   : byte;
  472.   LeftCol  : byte;
  473.   Top, Side, Bottom : string [11];
  474.   BoxColor : byte;
  475.  
  476. BEGIN
  477.   { outline box is blank }
  478.   Top := EmptyBoxTop;
  479.   Side := EmptyBoxSide;
  480.   Bottom := EmptyBoxTop;
  481.   TopRow := trunc (1 + ((LastColor div 8) * 5));
  482.   LeftCol := succ ((LastColor mod 8) * 10);
  483.  
  484.   { erase old outline box }
  485.   if CurrentColor <> LastColor then begin
  486.     FastWrite (Top, TopRow, LeftCol, Black);
  487.     inc (TopRow);
  488.     FastVert (Side, TopRow, LeftCol, Black);
  489.     FastVert (Side, TopRow, LeftCol + 9, Black);
  490.     FastWrite (Bottom, TopRow + 4, LeftCol, Black);
  491.     end;
  492.  
  493.   { outline box is frame }
  494.   Top := BoxTop;
  495.   Side := BoxSide;
  496.   Bottom := BoxBottom;
  497.   TopRow := trunc (1 + ((CurrentColor div 8) * 5));
  498.   LeftCol := succ ((CurrentColor mod 8) * 10);
  499.   if Pending.Status > -1 then                              { color of box }
  500.     BoxColor := LightRed
  501.   else
  502.     BoxColor := White;
  503.  
  504.   { draw new outline box }
  505.   FastWrite (Top, TopRow, LeftCol, BoxColor);              { draw box }
  506.   inc (TopRow);
  507.   FastVert (Side, TopRow, LeftCol, BoxColor);
  508.   FastVert (Side, TopRow, LeftCol + 9, BoxColor);
  509.   FastWrite (Bottom, TopRow + 4, LeftCol, BoxColor);
  510.  
  511.   LastColor := CurrentColor;
  512. END;
  513.  
  514. { ShowSelectedColor ======================================================= }
  515.  
  516. PROCEDURE ShowSelectedColor;
  517. VAR
  518.   Loop : integer;
  519.   StoreMouseCursor : boolean;
  520. BEGIN
  521.  
  522.   HideMousePrim (StoreMouseCursor);
  523.   for Loop := 1 to 5 do
  524.     FastWrite (CharStr (BxChar, 38), 11 + Loop, 22, CurrentColor);
  525.   DrawBox;
  526.   ShowPercentages (CurrentColor);
  527.   ShowMousePrim (StoreMouseCursor);
  528.  
  529. END;
  530.  
  531. { ShowSliderOption ======================================================== }
  532.  
  533. PROCEDURE ShowSliderOption;
  534. VAR
  535.   LocalColor : byte;
  536.   StoreMouseCursor : boolean;
  537.  
  538. BEGIN
  539.   if Pending.Status > -1 then exit;              { uh oh, operation pending }
  540.   if SliderOption = LastSliderOption then exit;  { no need to change option }
  541.  
  542.   HideMousePrim (StoreMouseCursor);
  543.   FastWrite ('  Saturate ', SaturationLine, 1, White);
  544.   FastWrite ('       Red ',        RedLine, 1, White);
  545.   FastWrite ('     Green ',      GreenLine, 1, White);
  546.   FastWrite ('      Blue ',       BlueLine, 1, White);
  547.   FastWrite (' Intensity ',  IntensityLine, 1, White);
  548.   ChangeAttribute (11,
  549.                    SaturationLine + SliderOption, 1,
  550.                    BlackOnLtGray + 128);
  551.   ShowMousePrim (StoreMouseCursor);
  552.   LastSliderOption := SliderOption;
  553. END;
  554.  
  555. { SetSlider =============================================================== }
  556.  
  557. PROCEDURE SetSlider (CurrentColor, SliderOption, NewVal : integer);
  558. { shell for SetVgaRegister. }
  559. VAR
  560.   Vector  : integer;
  561.  
  562. BEGIN
  563.   if Pending.Status > -1 then exit;              { uh oh, operation pending }
  564.  
  565.   NewVal := min (max (NewVal, 0), 63);           { check range }
  566.   With VgaReg, ColorValues do
  567.     case SliderOption of
  568.       0    : begin
  569.              While
  570.                (Saturation <> NewVal)
  571.              do begin
  572.                if Saturation > NewVal then Vector := 1 else Vector := -1;
  573.                SetSaturation (Vector);
  574.                end;
  575.              Pal.Get;
  576.              ShowPercentages (CurrentColor);
  577.              end;
  578.       1..3 : With Pal do begin
  579.                SetRGB (CurrentColor,
  580.                        SliderOption,
  581.                        round (MinReal (MaxReal (NewVal, 0), 63)));
  582.                ShowPercentages (CurrentColor);
  583.                end;
  584.       4    : begin
  585.              While
  586.                (Intensity <> NewVal)
  587.              do begin
  588.                if Intensity < NewVal then Vector := 1 else Vector := -1;
  589.                SetIntensity (Vector);
  590.                end;
  591.              Pal.Get;
  592.              ShowPercentages (CurrentColor);
  593.              end;
  594.       end;  { case }
  595. END;
  596.  
  597. { GoBack ================================================================== }
  598.  
  599. PROCEDURE GoBack;
  600. VAR
  601.   P : VgaRegArray;
  602. BEGIN
  603.  
  604.   if Pending.Status > -1 then                    { if operation pending }
  605.     Pending.Erase                                { then cancel it }
  606.   else begin                                     { else }
  607.  
  608.     Pal.Pop (P);                                 { pop last palette }
  609.     Pal.DissolveTo (P);                          { and dissolve to it }
  610.     end;
  611. END;
  612.  
  613. { RandomPalette =========================================================== }
  614.  
  615. PROCEDURE RandomPalette;
  616. VAR
  617.   Loop, Color : byte;
  618.   NewPal     : VgaRegArray;
  619.  
  620. BEGIN
  621.   NewPal := Pal.P;
  622.   for Loop := 0 to 15 do
  623.     for Color := 1 to 3 do
  624.       NewPal [Loop, succ (random (3))] := random (10) * 7;
  625.   Pal.DissolveTo (NewPal);
  626. END;
  627.  
  628. { HandleIsDevice ========================================================== }
  629.  
  630. FUNCTION HandleIsDevice (H : word) : boolean;
  631. VAR
  632.   R : registers;
  633. BEGIN
  634.   HandleIsDevice := false;
  635.   with R do begin
  636.     AH := $44;                                   { IOCTL }
  637.     AL := $00;                                   { subfunction 0 }
  638.     BX := H;
  639.     MsDos (R);
  640.     if not Odd (Flags) then
  641.       HandleIsDevice := DX and $80 <> 0;
  642.     end;
  643. END;
  644.  
  645. { GetUserFileName ========================================================= }
  646.  
  647. CONST
  648. GetFileNameFlag : boolean = false;
  649.  
  650. PROCEDURE GetUserFileName (VAR S : string);
  651. VAR
  652.   Len     : byte absolute S;
  653.   Le      : LineEditor;                          { line editor object }
  654.  
  655.   Loop    : byte;
  656.   F       : file;
  657.   Created : boolean;
  658.  
  659. BEGIN
  660.   GetFileNameFlag := true;
  661.   Le.Init (MenuColors);
  662.   EditCommands.cpOptionsOn (cpEnableMouse);         { turn mouse on }
  663.   EditCommands.AddCommand (ccQuit, 1, KcCtrlU, 0);  { exit on Ctrl-U }
  664.  
  665.   S := '';                                       { S = null string }
  666.   While S = '' do begin                          { while no valid file name }
  667.  
  668.     Created := false;
  669.     Le.ReadString (' Palette Name? ',
  670.                    14, 29, 8, 8, S);             { read S }
  671.     Case Le.GetLastCommand of
  672.       ccQuit : S := '';                          { cancel name }
  673.       end;
  674.  
  675.     if
  676.       (S = '')                                   { if no name }
  677.     then begin                                   { exit without name }
  678.       Le.Done;
  679.       ShowSelectedColor;
  680.       GetFileNameFlag := false;
  681.       exit;
  682.       end;
  683.  
  684.     S := StUpCase (S);                           { upcase S }
  685.  
  686.     Assign (F, S);                               { assign file name }
  687.     {$I-} Reset (F); {$I+}                       { open it }
  688.     if IOresult <> 0 then begin                  { IO error }
  689.       {$I-} Rewrite (F);  {$I+}
  690.       if IOresult <> 0 then begin                { IO error }
  691.         { failed to create file }
  692.         end
  693.       else begin                                 { file created }
  694.         { created the file }
  695.         Created := true;
  696.         end;
  697.       end
  698.  
  699.     else begin                                   { file already exists }
  700.       end;
  701.  
  702.     if FileRec (F).mode = fmClosed then begin    { file is closed }
  703.       end
  704.     else begin
  705.       if HandleIsDevice (FileRec(F).Handle) then begin
  706.         PauseMsgBox ('Sorry, DOS will not allow ''' + S +
  707.                      ''' to be used as a palette file name.  ' +
  708.                      'Please enter another name.',
  709.                      ReddbColorSet, dbJustify + dbShadow, 40);
  710.         S := '';                                 { cancel S, try again }
  711.         end;
  712.       Close (F);                                 { close file }
  713.       if Created then erase (F);                 { if created, erase file }
  714.       end;
  715.  
  716.     For Loop := 1 to Len do
  717.       if S [Loop] = ' ' then S [Loop] := '_';    { translate spaces }
  718.     end;                                         { while S = '' do begin }
  719.  
  720.   Le.Done;
  721.   ShowSelectedColor;
  722.   GetFileNameFlag := false;
  723. END;
  724.  
  725. { WritePalette ============================================================ }
  726.  
  727. PROCEDURE WritePalette;
  728. VAR
  729.   Pfile     : file of VgaRegArray;
  730.   PfileName : string;
  731.   PfileAttr : word;
  732.  
  733. BEGIN
  734.   PaletteFileName := JustName (PaletteFileName);
  735.  
  736.   if
  737.     (PaletteFileName = '')
  738.       or
  739.     ((PaletteFileName > '')
  740.       and
  741.     (not YornBox ('Store as ''' + PaletteFileName + ''' palette?  (Y/N)')))
  742.   then
  743.     GetUserFileName (PaletteFileName);
  744.  
  745.   if PaletteFileName = '' then exit;             { escape if no file name }
  746.   PfileName := ProgramPath + ForceExtension (PaletteFileName, 'PAL');
  747.  
  748.   if
  749.     not ExistFile (PFileName)
  750.       or
  751.     (ExistFile (PFileName)
  752.       and
  753.     YornBox ('The ''' + PaletteFileName +
  754.              ''' palette already exists as a file.  Overwrite?  (Y/N)'))
  755.   then begin
  756.     Assign (Pfile, PFileName);
  757.     GetFattr (Pfile, PfileAttr);
  758.     if PfileAttr and ReadOnly = ReadOnly then
  759.       PauseMsgBox ('Sorry.  The ''' + PaletteFileName +
  760.                    ''' palette has been stored as a read-only file.' +
  761.                    '  It cannot be overwritten.',
  762.                    RedDbColorSet, dbJustify + dbShadow, 40)
  763.     else begin
  764.       Rewrite (Pfile);
  765.       Write (Pfile, Pal.P);
  766.       Close (Pfile);
  767.       TimedPauseMsg ('The ''' + PaletteFileName + ''' palette has been saved.',
  768.                         GreenDbColorSet, dbShadow, 60, 1500);
  769.       end;
  770.     end;
  771. END;
  772.  
  773. { ReadDiskPalette ========================================================= }
  774.  
  775. PROCEDURE ReadDiskPalette;
  776. { Read palette from disk file . }
  777.  
  778. VAR
  779.   Pfile     : file of VgaRegArray;
  780.   PfileAttr : word;
  781.   NewPal    : VgaRegArray;
  782.  
  783. BEGIN
  784.   PaletteFileName := PickFile;
  785.   if PaletteFileName > '' then begin
  786.  
  787.     Assign (Pfile, PaletteFileName);
  788.     GetFattr (PFile, PfileAttr);
  789.     if PfileAttr and ReadOnly = ReadOnly then
  790.       SetFattr (PFile, 0);                       { workaround Turbo quirk }
  791.     Assign (Pfile, PaletteFileName);
  792.     Reset (Pfile);
  793.     Read (Pfile, NewPal);
  794.     Close (Pfile);
  795.     SetFattr (Pfile, PfileAttr);
  796.  
  797.     Pal.DissolveTo (NewPal);
  798.     end;
  799. END;
  800.  
  801. { LoadNewPalette ========================================================== }
  802.  
  803. PROCEDURE LoadNewPalette;
  804. { Load a palette from disk without running editor. }
  805.  
  806. VAR
  807.   Pfile     : file of VgaRegArray;
  808.   PfileAttr : word;
  809.   NewPal    : VgaRegArray;
  810.   Pname     : string [12];
  811.  
  812. BEGIN
  813.   Pal.Get;                                       { get active palette }
  814.   Wryte (ProgramName);
  815.  
  816.   Pname := ForceExtension (StUpCase (ParamStr (1)), 'PAL');
  817.   PaletteFileName := ProgramPath + Pname;
  818.   if not ExistAnyFile (PaletteFileName) then begin
  819.     WryteLn (' cannot locate ''' + Pname + '''');
  820.     exit;
  821.     end;
  822.  
  823.   WryteLn (' loading ' + PaletteFileName);
  824.  
  825.   Assign (Pfile, PaletteFileName);
  826.   GetFattr (PFile, PfileAttr);
  827.   if PfileAttr and ReadOnly = ReadOnly then
  828.     SetFattr (PFile, 0);                         { workaround Turbo quirk }
  829.   Assign (Pfile, PaletteFileName);
  830.   Reset (Pfile);
  831.   Read (Pfile, NewPal);
  832.   Close (Pfile);
  833.   SetFattr (Pfile, PfileAttr);
  834.   Pal.DissolveTo (NewPal);                       { dissolve to new palette }
  835. END;
  836.  
  837. { ========================================================================= }
  838. { MouseEventDeclarations ================================================== }
  839.  
  840. CONST
  841.   MouseEventReentryFlag : boolean = false;
  842.   RightButtonFlag       : boolean = false;
  843.   RandomPaletteFlag     : boolean = false;
  844.  
  845. VAR
  846.   TempStack : array [1..4096] of byte;           { temporary stack }
  847.  
  848. { UserHook ================================================================ }
  849.  
  850. {$F+}
  851. PROCEDURE UserHook (CPP : CommandProcessorPtr;
  852.                     MT  : MatchType;
  853.                     Key : word);
  854. {$F-}
  855. BEGIN
  856. {
  857.   Can't do a dissolve inside the mouse event handler.  It screws things up.
  858.   Instead, look to see if the flag is set;  if it is, do the dissolve here.
  859. }
  860.   if not RandomPaletteFlag then exit;
  861.   RandomPaletteFlag := false;
  862.   RandomPalette;
  863. END;
  864.  
  865. { MouseEventKernel ======================================================== }
  866.  
  867. {$F+} PROCEDURE MouseEventKernel (Var Dummy : IntRegisters); {$F-}
  868. {
  869.   This procedure contains the real work of the mouse event handler.
  870. }
  871.  
  872. CONST
  873.   MinCol = 13;
  874.   MaxCol = 76;
  875.   WindowRestricted : boolean = false;
  876.  
  877. VAR
  878.   CharAtMouseCursor : char;                      { what char under mouse }
  879.   AttrAtMouseCursor : byte;                      { what attr under mouse }
  880.  
  881. { ------------------------- }
  882.  
  883. PROCEDURE BoxCharClicked;
  884. BEGIN
  885.   { if mouse was clicked on any of 16 little boxes... }
  886.   if MouseLastY < 11 then begin
  887.     if CurrentColor <> AttrAtMouseCursor then begin
  888.       CueClick;
  889.       CurrentColor := AttrAtMouseCursor;         { change active color }
  890.  
  891.       { If flag set then swap color with current color }
  892.       if Pending.Status > -1 then begin          { if operation pending }
  893.         Pal.Swap (SelectColor, CurrentColor);
  894.         Pending.Erase;                           { zap pending box }
  895.         end;
  896.       ShowSelectedColor;
  897.       end;
  898.     end
  899.  
  900.   { User has clicked on large current color box in center of the screen. }
  901.   else begin
  902.     CueClick;
  903.     { get ready for a swap, dupe, or random palette }
  904.     if (TimeMs - MouseStoreTime) < 333 then begin
  905.       Pending.Erase;
  906.       { Can't do a dissolve inside the event handler, it interferes
  907.         with the mouse, so set a flag instead and trigger it in
  908.         the UserHook procedure. }
  909.       RandomPaletteFlag := true;
  910.       end
  911.     else begin
  912.       MouseStoreTime := TimeMs;
  913.       Pending.Draw;                              { operation pending }
  914.       SelectColor := CurrentColor;
  915.       end;
  916.     end;
  917. END;
  918.  
  919. { ------------------------- }
  920.  
  921.   PROCEDURE EndSliders;
  922.   BEGIN
  923.     { end slider move, restore mouse window }
  924.     if not WindowRestricted then exit;
  925.  
  926.     FullMouseWindow;
  927.     WindowRestricted := false;
  928.     { restore mouse cursor shape }
  929.     With MenuColors do
  930.       SoftMouseCursor($0000, (ColorMono (MouseColor, MouseMono) shl 8) +
  931.                               Byte (MouseChar));
  932.     ShowMouse;
  933.     Pal.Push;                                    { store it on pal stack }
  934.   END;
  935.  
  936. { ------------------------- }
  937.  
  938.   PROCEDURE DoLeftButtonReleased;
  939.   BEGIN
  940. {
  941.   If the Pending msg is active, then a color operation is pending.
  942.   Left button down sends msg that color duplication is pending,
  943.   left button up means color swap is pending.
  944. }
  945.     if Pending.Status > -1 then begin            { if operation pending }
  946.       Pending.SetStatus (succ (ord (MouseStatus = LeftButton)));
  947. {
  948.   If mouse has been dragged to target color box, then
  949.   duplicate the current color into the target color.
  950. }
  951.       if
  952.         (CharAtMouseCursor = BxChar) and         { if target color box }
  953.         (MouseLastY < 11)
  954.       then begin
  955.         CueClick;
  956.         CurrentColor := AttrAtMouseCursor;       { get current color }
  957.         Pal.Dupe (SelectColor, CurrentColor);    { duplicate }
  958.         Pending.Erase;                           { zap pending msg }
  959.         ShowSelectedColor;                       { update screen }
  960.         end;
  961.       end
  962.     else
  963.       EndSliders;                                { if WindowRestricted }
  964.   END;
  965.  
  966. { ------------------------- }
  967.  
  968.   PROCEDURE DoMouseMoved;
  969.   BEGIN
  970.  
  971. { If the Pending window is open then a color operation is pending.
  972.   Left button down sends msg that color duplication is pending,
  973.   left button up means color swap is pending.  }
  974.  
  975.     if Pending.Status > -1 then begin
  976.       if CharAtMouseCursor = BxChar then
  977.         Pending.SetStatus (succ (ord (MouseStatus = LeftButton)))
  978.       else begin
  979.         Case Pending.Status of
  980.           0, 2 : Pending.SetStatus (succ (ord (MouseStatus = LeftButton)));
  981.           end;  { case}
  982.         end;
  983.       end
  984.  
  985. { Any other mouse move would be a slider.  If user is not
  986.   pressing the left button, then end all slider operations now. }
  987.  
  988.     else
  989.       if MouseStatus <> LeftButton then
  990.         EndSliders
  991.  
  992. { If the left button is down and the window is restricted, then
  993.   user is dragging a slider.  If he's not dragging a slider, then
  994.   he clicked while moving the mouse. }
  995.  
  996.       else
  997.         if WindowRestricted then begin           { drag a slider }
  998.           SliderSound;
  999.           delay (3);
  1000.           HideMouse;
  1001.           SetSlider (CurrentColor, SliderOption, MouseLastX - 1);
  1002.           ShowMouse;
  1003.           NoSound;
  1004.           end;
  1005.   END;
  1006.  
  1007. { ------------------------- }
  1008.  
  1009.   PROCEDURE DoLeftButtonPressed;
  1010.   BEGIN
  1011.     if
  1012.       (MouseLastY >= SaturationLine)             { if mouse in slider frame }
  1013.         and
  1014.       (MouseLastY <= IntensityLine)
  1015.     then begin                                   { then set sliders }
  1016.       SliderOption := MouseLastY - SaturationLine;
  1017.       ShowSliderOption;
  1018.       CueClick;
  1019.       end;
  1020.  
  1021.     case CharAtMouseCursor of
  1022.       BxChar       : BoxCharClicked;
  1023.  
  1024.       SliderChar,
  1025.       LineChar     : begin
  1026.                      Pending.Erase;
  1027.                      { force window around mouse }
  1028.                      MouseWindow (MinCol, SaturationLine + SliderOption,
  1029.                                   MaxCol, SaturationLine + SliderOption);
  1030.                      WindowRestricted := true;
  1031.                      SliderSound;
  1032.                      { change Mouse cursor shape }
  1033.                      With MenuColors do
  1034.                        SoftMouseCursor($0000,
  1035.                          (ColorMono (MouseColor, MouseMono) shl 8) +
  1036.                            Byte (SliderChar));
  1037.                      { update the slider }
  1038.                      HideMouse;
  1039.                      SetSlider (CurrentColor, SliderOption, MouseLastX - 13);
  1040.                      ShowMouse;
  1041.                      nosound;
  1042.                      end;
  1043.  
  1044.       SaturationChar,
  1045.       IntensityChar,
  1046.       FrameChar    : begin
  1047.                      Pending.Erase;
  1048.                      if (MouseLastY = SaturationLine) or
  1049.                         (MouseLastY = IntensityLine)
  1050.                      then
  1051.                        With VgaReg, ColorValues do begin
  1052.                          Case SliderOption of
  1053.                            0 : begin
  1054.                                GetSaturation (CurrentColor);
  1055.                                With MenuColors do
  1056.                                  SoftMouseCursor ($0000,
  1057.                                    (ColorMono (MouseColor, MouseMono) shl 8)
  1058.                                      + Byte (SaturationChar));
  1059.                                end;
  1060.                            4 : begin
  1061.                                GetIntensity (CurrentColor);
  1062.                                With MenuColors do
  1063.                                  SoftMouseCursor ($0000,
  1064.                                    (ColorMono (MouseColor, MouseMono) shl 8)
  1065.                                      + Byte (IntensityChar));
  1066.                                end;
  1067.                            end; { case }
  1068.  
  1069.                          if
  1070.                            (SliderOption = 0)
  1071.                              or
  1072.                            (SliderOption = 4)
  1073.                          then begin
  1074.                            { force window around mouse }
  1075.                            MouseWindow (MinCol,
  1076.                                         SaturationLine + SliderOption,
  1077.                                         MaxCol,
  1078.                                         SaturationLine + SliderOption);
  1079.                            WindowRestricted := true;
  1080.                            SliderSound;
  1081.                            { update the slider }
  1082.                            HideMouse;
  1083.                            SetSlider
  1084.                              (CurrentColor, SliderOption, MouseLastX - 13);
  1085.                            ShowMouse;
  1086.                            nosound;
  1087.                            end;
  1088.                          end;  { with VgaReg, ColorValues do begin }
  1089.                      end;  { begin }
  1090.       end; { case }
  1091.   END;
  1092.  
  1093. { ------------------------- }
  1094.  
  1095. BEGIN;
  1096.   { If right button is pressed, do not allow left button events. }
  1097.   if MouseEvent and RightButtonReleased <> 0 then
  1098.     RightButtonFlag := false;
  1099.   if MouseEvent and RightButtonPressed <> 0 then
  1100.     RightButtonFlag := true;
  1101.   if RightButtonFlag then exit;
  1102.  
  1103.   GotoxyAbs (MouseLastX, MouseLastY);            { send cursor to mouse }
  1104.   HideMouse;                                     { no mouse }
  1105.   ReadAtCursor
  1106.     (CharAtMouseCursor, AttrAtMouseCursor);      { read screen }
  1107.   ShowMouse;                                     { return mouse }
  1108.  
  1109.   Case MouseEvent of
  1110.     MouseMoved + LeftButtonReleased,
  1111.     LeftButtonReleased               : DoLeftButtonReleased;
  1112.     MouseMoved + LeftButtonPressed,
  1113.     LeftButtonPressed                : DoLeftButtonPressed;
  1114.     MouseMoved                       : DoMouseMoved;
  1115.     end;  { case }
  1116. END;
  1117.  
  1118. { MouseEventHandler ======================================================= }
  1119.  
  1120. {$F+} PROCEDURE MouseEventHandler; {$F-}
  1121.  
  1122. VAR
  1123.   Dummy : IntRegisters;
  1124.  
  1125. BEGIN;
  1126.   if M.ActiveSubPtr <> nil then                  { if submenus are active }
  1127.     exit;                                        { don't do anything }
  1128.   if PrismHelp.IsActive then exit;               { if help window open }
  1129.   if GetFileNameFlag then exit;                  { if getting a file name }
  1130.  
  1131.   if MouseEventReentryFlag then exit;            { don't enter here twice }
  1132.   MouseEventReentryFlag := true;                 { set reentry flag }
  1133.  
  1134.   SwapStackAndCall (@MouseEventKernel,
  1135.                     @TempStack [sizeof (TempStack)],
  1136.                     Dummy);                      { get real event handler }
  1137.  
  1138.   MouseEventReentryFlag := false;                { reset reentry flag }
  1139. END;
  1140.  
  1141. { ========================================================================= }
  1142. { SetMouseSpeed =========================================================== }
  1143.  
  1144. PROCEDURE SetMouseSpeed (NewSpeed : byte);
  1145. BEGIN
  1146.   Case NewSpeed of
  1147.     0 : SetMickeyToPixelRatio (16, 32);
  1148.     1 : SetMickeyToPixelRatio (8, 16);
  1149.     2 : SetMickeyToPixelRatio (4, 8);
  1150.     3 : SetMickeyToPixelRatio (2, 4);
  1151.     end; { case }
  1152.   MouseSpeed := NewSpeed;
  1153.   { save new default }
  1154. END;
  1155.  
  1156. { PostInstructions ======================================================== }
  1157.  
  1158. PROCEDURE PostInstructions;
  1159. VAR
  1160.   Left, Right : byte;
  1161. CONST
  1162.   LocalColor : byte = LightGray;
  1163.  
  1164. BEGIN
  1165.   if MouseInstalled then begin
  1166.     Left := 3;  Right := 63;
  1167.     FastWrite ('Click on square', 13, Left, LocalColor);
  1168.     FastWrite ('to change the',   14, Left, LocalColor);
  1169.     FastWrite ('active color.',   15, Left, LocalColor);
  1170.     FastWrite ('Click on slider', 13, Right, LocalColor);
  1171.     FastWrite ('and hue options', 14, Right, LocalColor);
  1172.     FastWrite ('to alter shade. ', 15, Right, LocalColor);
  1173.     end
  1174.   else begin
  1175.     Left := 1;  Right := 63;
  1176.     FastWrite ('Use Ctrl-Left-Arrow', 13, Left, LocalColor);
  1177.     FastWrite ('or Ctrl-Right-Arrow', 14, Left, LocalColor);
  1178.     FastWrite ('to select a color.', 15, Left, LocalColor);
  1179.     FastWrite ('Use Shift-Arrows', 13, Right, LocalColor);
  1180.     FastWrite ('to move sliders ',  14, Right, LocalColor);
  1181.     FastWrite ('and hue options.', 15, Right, LocalColor);
  1182.     end;
  1183. END;
  1184.  
  1185. { ShowMainScreen ========================================================== }
  1186.  
  1187. {$F+} PROCEDURE ShowMainScreen; {$F-}
  1188. VAR
  1189.   Loop : byte;
  1190.  
  1191. BEGIN
  1192.   MouseStoreTime := TimeMs;                      { mouse click time delay }
  1193.  
  1194.   SetBlink (false);                              { no blinking }
  1195.   ClrScr;
  1196.   for Loop := 0 to 15 do
  1197.     DrawAttributeBox (Loop);                     { draw attribute boxes }
  1198.  
  1199.   PostInstructions;                              { normal instructions }
  1200.   ShowSelectedColor;                             { current color }
  1201.   ShowSliderOption;                              { which slider }
  1202.  
  1203. { Menu Initializations ---------------------------------------------------- }
  1204.  
  1205.   Status := InitMenu (M);
  1206.   if Status <> 0 then begin
  1207.     WriteLn('Error initializing menu: ', Status);
  1208.     Halt(1);
  1209.   end;
  1210.  
  1211.   Status := InitHelpLine (H);
  1212.   if Status <> 0 then begin
  1213.     WriteLn('Error initializing help line: ', Status);
  1214.     Halt(1);
  1215.   end;
  1216.   M.SetCurrentItemProc (UpdateHelpLine);
  1217.  
  1218.   H.Draw;                                        { draw help }
  1219.   M.Draw;                                        { draw menu }
  1220.  
  1221.   if MouseInstalled then
  1222.     with MenuColors do begin
  1223.       DisableEventHandling;                      { no mouse events yet }
  1224.  
  1225.       {activate mouse cursor}
  1226.       SoftMouseCursor($0000, (ColorMono (MouseColor, MouseMono) shl 8)+
  1227.                              Byte (MouseChar));
  1228.       ShowMouse;
  1229.       { enable mouse support }
  1230.       MenuCommands.cpOptionsOn (cpEnableMouse);
  1231.       SetMouseSpeed (MouseSpeed);
  1232.       MouseGotoxy (80, 25);                      { go to your corner }
  1233.       KeyStateByte := 0;
  1234.       end
  1235.   else begin
  1236.     M.ProtectItem (miMouse3);                    { no mouse help }
  1237.     M.ProtectItem (miMouse11);                   { no mouse speed reset }
  1238.     KeyStateByte := NumLock;                     { turn editing keys on }
  1239.     end;
  1240.  
  1241.   CW.InitCustom  (23, 13, 58, 15, MenuColors, wClear + wBordered);
  1242.   CW.SetCursor (CuHidden);
  1243.   CW.Draw;
  1244.   CW.wFastCenter (ProgramName, 1, WhiteOnCyan);
  1245.   CW.wFastCenter ('a VGA palette editor', 2, BlackOnCyan);
  1246.   CW.wFastCenter ('by David Gerrold', 3, BlackOnCyan);
  1247.  
  1248. END;
  1249.  
  1250. { ========================================================================= }
  1251. { PendOb.Init ============================================================= }
  1252.  
  1253. PROCEDURE PendOb.Init;
  1254. BEGIN
  1255.   Status := -1;
  1256. END;
  1257.  
  1258. { PendOb.Draw ============================================================= }
  1259.  
  1260. PROCEDURE PendOb.Draw;
  1261. VAR
  1262.   Left, Right : byte;
  1263. BEGIN
  1264.   Status := 0;
  1265.   DrawBox;
  1266.  
  1267.   Left := 1;  Right := 62;
  1268.   FastWrite (PadCenter ('Color', 18),          13, Left, LightRed);
  1269.   FastWrite (PadCenter ('Operation', 18),      14, Left, LightRed);
  1270.   FastWrite (PadCenter ('Pending', 18),        15, Left, LightRed);
  1271.   FastWrite (PadCenter ('Click to swap ', 16),  13, Right, LightRed);
  1272.   FastWrite (PadCenter ('Drag to dupe  ', 16),   14, Right, LightRed);
  1273.   FastWrite (PadCenter ('Undo to cancel', 16), 15, Right, LightRed);
  1274. END;
  1275.  
  1276. { PendOb.SetStatus ======================================================== }
  1277.  
  1278. PROCEDURE PendOb.SetStatus (NewStatus : integer);
  1279. CONST
  1280.   StatusMsg : array [1 .. 2] of string [12] =
  1281.               ('Swap ',
  1282.                'Duplication');
  1283. VAR
  1284.   Left : byte;
  1285. BEGIN
  1286.   if Status < 0 then exit;
  1287.   if Status = NewStatus then exit;
  1288.  
  1289.   Status := NewStatus;
  1290.   Left := 1;
  1291.   FastWrite (PadCenter (StatusMsg [NewStatus], 18), 14, Left, LightRed);
  1292. END;
  1293.  
  1294. { PendOb.Erase ============================================================ }
  1295.  
  1296. PROCEDURE PendOb.Erase;
  1297. BEGIN
  1298.   PostInstructions;
  1299.   Status := -1;
  1300. END;
  1301.  
  1302. { ========================================================================= }
  1303. { EndProc ================================================================= }
  1304.  
  1305. {$F+}
  1306. PROCEDURE EndProc;
  1307. BEGIN
  1308.   PrismHelp.Done;                                { no more help object }
  1309.   H.Done;                                        { end help }
  1310.   M.Done;                                        { end menu }
  1311. END;
  1312. {$F-}
  1313.  
  1314. { ========================================================================= }
  1315. { RunEditor =============================================================== }
  1316.  
  1317. PROCEDURE RunEditor;
  1318. VAR
  1319.   SliderFlag : boolean;                          { for ccUser4 & ccuser6 }
  1320.   StoreTime  : longint;
  1321.  
  1322. CONST
  1323.   LastccUser : byte = 0;                         { last cursorpad char }
  1324.  
  1325. BEGIN
  1326.   Pal.Init;                                      { start palette }
  1327.   Pending.Init;                                  { initialize pending box }
  1328.  
  1329.   LastColor    := 0;
  1330.   CurrentColor := succ (Random (15));            { pick a color }
  1331.   LastSliderOption := 4;
  1332.   SliderOption := 0;                             { which slider }
  1333.  
  1334. { Menu Initializations ---------------------------------------------------- }
  1335.  
  1336.   MenuCommands.SetUserHookProc (UserHook);
  1337.  
  1338.   MenuCommands.AddCommand (ccQuit, 1, KcCtrlU, 0);
  1339.  
  1340.   MenuCommands.AddCommand (ccUser2, 1, KcNumpad2, 0);
  1341.   MenuCommands.AddCommand (ccUser4, 1, KcNumpad4, 0);
  1342.   MenuCommands.AddCommand (ccUser6, 1, KcNumpad6, 0);
  1343.   MenuCommands.AddCommand (ccUser8, 1, KcNumpad8, 0);
  1344.   MenuCommands.AddCommand (ccUser10, 1, KcCtrlD, 0);
  1345.   MenuCommands.AddCommand (ccUser11, 1, KcCtrlN, 0);
  1346.   MenuCommands.AddCommand (ccUser12, 1, KcCtrlR, 0);
  1347.   MenuCommands.AddCommand (ccUser13, 1, KcCtrlS, 0);
  1348.  
  1349.   MenuCommands.AddCommand (ccUser15, 1, KcCtrlLeftArrow, 0);
  1350.   MenuCommands.AddCommand (ccUser16, 1, KcCtrlRightArrow, 0);
  1351.   MenuCommands.AddCommand (ccUser17, 1, KcNumPadDot, 0);
  1352.   MenuCommands.AddCommand (ccUser18, 1, KcCtrlHomeKey, 0);
  1353.  
  1354.   MenuCommands.AddCommand (ccUser20, 1, MouseBoth, 0);
  1355.  
  1356.   Status := MenuCommands.GetLastError;
  1357.   if Status <> 0 then begin
  1358.     WryteLn ('Failed to add commands.  Error: ' + Num2Str (Status));
  1359.     halt;
  1360.     end;
  1361.  
  1362. { Help Initialization ----------------------------------------------------- }
  1363.  
  1364.   { Make a help window with custom options }
  1365.   if not PrismHelp.InitMemCustom (9, 8, 72, 18,
  1366.                                  MenuColors,
  1367.                                  wBordered,
  1368.                                  @HelpText,
  1369.                                  PickVertical)
  1370.   then begin
  1371.     WryteLn ('Failed to initialize Help System.');
  1372.     halt;
  1373.     end;
  1374.  
  1375.   { Add some features }
  1376.   PrismHelp.EnableExplosions (6);
  1377.   PrismHelp.wFrame.AddHeader (' Topic Index ', heTC);
  1378.   PrismHelp.AddMoreHeader (' || for more ', heBR, #24, #25, '', 2, 3, 0);
  1379.   PrismHelp.AddTopicHeader (1, 60, heTC);
  1380.   PrismHelp.AddMoreHelpHeader (
  1381.     ' PgUp/PgDn for more ', heBR, 'PgUp', 'PgDn', '/', 2, 7, 6);
  1382.  
  1383.   PrismHelp.wFrame.AddShadow (shBr, shSeeThru);
  1384.   PrismHelp.hwFrame.AddShadow (shBr, shSeeThru);
  1385.  
  1386.   if SfxFlag then
  1387.     PrismHelp.wOptionsOn (wSoundEffects);
  1388.   HelpCommands.cpOptionsOn (cpEnableMouse);      { Add mouse support }
  1389.  
  1390. { Fade out Dos, Fade in Program ------------------------------------------- }
  1391.  
  1392.   FadeStart (ShowMainScreen, co80);              { put up display }
  1393.   DissolveProc := SlidePercentages;
  1394.   SetMouseEventHandler (AllMouseEvents,
  1395.                         @MouseEventHandler);
  1396.   EnableEventHandling;
  1397.  
  1398. {
  1399.   Certain processes need to occur within the ShowMainScreen procedure
  1400.   because they need to happen after the DOS screen fades out, but before
  1401.   the program screen fades in.  In particular, H.Draw and M.Draw, which
  1402.   draw the help line and menu on the screen.
  1403.  
  1404.   Mouse event handling must be disabled during fade in and fade out of
  1405.   program, because a mouse event may trigger a crash during the dissolve
  1406.   process.
  1407. }
  1408. { Run program ------------------------------------------------------------- }
  1409.  
  1410.   StoreTime := TimeMs;                           { get time }
  1411.   repeat
  1412.     if StoreTime > TimeMs then                   { allow for midnight }
  1413.       StoreTime := TimeMs;
  1414.   until                                          { wait until }
  1415.     KeyOrButtonPressed or                        { key event }
  1416.     ((TimeMs - StoreTime) > 3000);               { or 3 seconds }
  1417.   CW.done;                                       { erase colophon }
  1418.   ShowSelectedColor;                             { show correct color }
  1419.  
  1420.   ExitFlag := false;
  1421.   repeat
  1422.     M.Process;
  1423.     if M.GetLastCommand = ccSelect then begin
  1424.       case M.MenuChoice of
  1425.         miKeypad2       : GetHelp (miKeypad2);
  1426.         miMouse3        : GetHelp (miMouse3);
  1427.         miAbout4        : GetHelp (miAbout4);
  1428.         miAbout5        : GetHelp (miAbout5);
  1429.         miUsing6        : GetHelp (miUsing6);
  1430.         miReferences7   : GetHelp (miReferences7);
  1431.         miCopyright8    : GetHelp (miCopyright8);
  1432.         miSound10       : begin
  1433.                           CueClick;
  1434.                           SfxFlag := not SfxFlag;
  1435.                           if SfxFlag then
  1436.                             PrismHelp.wOptionsOn (wSoundEffects)
  1437.                           else
  1438.                             PrismHelp.wOptionsOff (wSoundEffects);
  1439.                           SfxOptions := byte (SfxFlag);
  1440.                           end;
  1441.         miMouse11       : begin
  1442.                           CueClick;
  1443.                           UpCycle (MouseSpeed, 0, 3);
  1444.                           SetMouseSpeed (MouseSpeed);
  1445.                           end;
  1446.         miDissolve12    : begin
  1447.                           CueClick;
  1448.                           UpCycle (DissolveDelay, 0, 6);
  1449.                           FadeRate := FadeRateArray [DissolveDelay];
  1450.                           end;
  1451.         miUndo14        : begin
  1452.                           CueClick;
  1453.                           M.EraseCurrentSubMenu;
  1454.                           GoBack;
  1455.                           end;
  1456.         miSwap15        : begin
  1457.                           CueClick;
  1458.                           M.EraseCurrentSubMenu;
  1459.                           if
  1460.                             (Pending.Status = 1) and
  1461.                             (CurrentColor <> SelectColor)
  1462.                           then begin
  1463.                             Pending.Erase;
  1464.                             Pal.Swap (SelectColor, CurrentColor);
  1465.                             ShowPercentages (CurrentColor);
  1466.                             end
  1467.                           else begin
  1468.                             Pending.Draw;
  1469.                             Pending.SetStatus (1);
  1470.                             SelectColor := CurrentColor;
  1471.                             end;
  1472.                           end;
  1473.         miRestore16     : begin;
  1474.                           CueClick;
  1475.                           M.EraseCurrentSubMenu;
  1476.                           Pal.DissolveTo (StoreVgaPal);
  1477.                           end;
  1478.         miNew17         : begin
  1479.                           CueClick;
  1480.                           M.EraseCurrentSubMenu;
  1481.                           RandomPalette;
  1482.                           end;
  1483.         miDuplicate18   : begin
  1484.                           CueClick;
  1485.                           M.EraseCurrentSubMenu;
  1486.                           if
  1487.                             (Pending.Status = 2) and
  1488.                             (CurrentColor <> SelectColor)
  1489.                           then begin
  1490.                             Pending.Erase;
  1491.                             Pal.Dupe (SelectColor, CurrentColor);
  1492.                             ShowPercentages (CurrentColor);
  1493.                             end
  1494.                           else begin
  1495.                             Pending.Draw;
  1496.                             Pending.SetStatus (2);
  1497.                             SelectColor := CurrentColor;
  1498.                             end;
  1499.                           end;
  1500.         miLoad19        : begin
  1501.                           CueClick;
  1502.                           M.EraseCurrentSubMenu;
  1503.                           ReadDiskPalette;
  1504.                           end;
  1505.         miSave20        : begin
  1506.                           CueClick;
  1507.                           M.EraseCurrentSubMenu;
  1508.                           WritePalette;
  1509.                           end;
  1510.         miYesExit22     : begin
  1511.                           CueClick;
  1512.                           M.EraseCurrentSubMenu;
  1513.                           DissolveProc := zen;
  1514.                           ExitFlag := true;
  1515.                           end;
  1516.         miNoResume23    : begin
  1517.                           CueClick;
  1518.                           M.EraseCurrentSubMenu;
  1519.                           end;
  1520.         end;  { case }
  1521.       end
  1522.     else
  1523.  
  1524.       if M.ActiveSubPtr <> nil then begin        { if active submenu }
  1525.         case M.GetLastCommand of
  1526.           { Esc, MouseRt, Ctrl-U }
  1527.           ccQuit : begin                         { if Quit }
  1528.                    M.EraseCurrentSubMenu;        { erase submenu }
  1529.                    CueClick;                     { make noise }
  1530.                    end;
  1531.           end;  { case }
  1532.         end
  1533.  
  1534.       else begin                                 { if no active submenus }
  1535.                                                  { edit the palette }
  1536. {
  1537.   If the last command was a slider change the the current command
  1538.   is not a slider change, then Push the current palette onto the undo
  1539.   stack so it can be restored.
  1540. }
  1541.         if
  1542.           not SliderFlag and
  1543.           (M.GetLastCommand <> ccUser4) and (M.GetLastCommand <> ccUser6)
  1544.         then
  1545.           Pal.Push;
  1546.  
  1547. {
  1548.   Case statement for processing user commands.
  1549. }
  1550.         case M.GetLastCommand of
  1551.  
  1552.           { Undo:  Esc, ^U or Mouse right button }
  1553.           ccQuit          : begin
  1554.                             CueClick;            { make noise first }
  1555.                             if Pending.Status > -1 then
  1556.                               Pending.Erase      { cancel pending operation }
  1557.                             else                 { or }
  1558.                               GoBack;            { restore previous palette }
  1559.                             end;
  1560.  
  1561.           { NumPad 2 }
  1562.           ccUser2         : begin
  1563.                             UpCycle (SliderOption, 0, 4);
  1564.                             ShowSliderOption;
  1565.                             CueClick;
  1566.                             end;
  1567.  
  1568.           { NumPad 4, 6 }
  1569.           ccUser4,
  1570.           ccUser6         : With VgaReg, ColorValues do begin
  1571.                             SliderFlag := (LastccUser <> ccUser4) and
  1572.                                           (LastccUser <> ccUser6);
  1573.                             Case SliderOption of
  1574.                               0    : if SliderFlag then
  1575.                                        GetSaturation (CurrentColor);
  1576.                               1..3 : Get (CurrentColor);
  1577.                               4    : if SliderFlag then
  1578.                                         GetIntensity (CurrentColor);
  1579.                               end;  { case }
  1580.                             if
  1581.                               ((SliderOption > 0) and (SliderOption < 4))
  1582.                                 or
  1583.                               not (SliderFlag
  1584.                                 and
  1585.                               (((SliderOption = 0) and (Saturation = 0))
  1586.                                 or
  1587.                               ((SliderOption = 4) and (Intensity = 0))))
  1588.                             then begin
  1589.                               { update the slider }
  1590.                               Case M.GetLastCommand of
  1591.                                 ccUser4 : SetSlider
  1592.                                             (CurrentColor, SliderOption,
  1593.                                                ValArray [SliderOption] - 1);
  1594.                                 ccUser6 : SetSlider
  1595.                                             (CurrentColor, SliderOption,
  1596.                                                ValArray [SliderOption] + 1);
  1597.                                 end;  { case }
  1598.                               SliderBeep;
  1599.                               end;
  1600.                             end;
  1601.  
  1602.           { NumPad 8 }
  1603.           ccUser8         : begin
  1604.                             DownCycle (SliderOption, 0, 4);
  1605.                             ShowSliderOption;
  1606.                             CueClick;
  1607.                             end;
  1608.           { ^D for duplicate }
  1609.           ccUser10        : begin
  1610.                             CueClick;
  1611.                             if
  1612.                               (Pending.Status = 2) and
  1613.                               (CurrentColor <> SelectColor)
  1614.                             then begin
  1615.                               Pending.Erase;
  1616.                               Pal.Dupe (SelectColor, CurrentColor);
  1617.                               ShowPercentages (CurrentColor);
  1618.                               end
  1619.                             else begin
  1620.                               Pending.Draw;
  1621.                               Pending.SetStatus (2);
  1622.                               SelectColor := CurrentColor;
  1623.                               end;
  1624.                             end;
  1625.  
  1626.           { 'N' for new }
  1627.           ccUser11        : begin
  1628.                             CueClick;
  1629.                             RandomPalette;
  1630.                             end;
  1631.  
  1632.           { 'R', or MouseBoth for restore }
  1633.           ccUser12,
  1634.           ccUser20        : begin
  1635.                             CueClick;
  1636.                             Pending.Erase;
  1637.                             RightButtonFlag := false;
  1638.                             Pal.DissolveTo (StoreVgaPal);
  1639.                             end;
  1640.  
  1641.           { 'S' for swap }
  1642.           ccUser13        : begin
  1643.                             CueClick;
  1644.                             if
  1645.                               (Pending.Status = 1) and
  1646.                               (CurrentColor <> SelectColor)
  1647.                             then begin
  1648.                               Pending.Erase;
  1649.                               Pal.Swap (SelectColor, CurrentColor);
  1650.                               ShowPercentages (CurrentColor);
  1651.                               end
  1652.                             else begin
  1653.                               Pending.Draw;
  1654.                               Pending.SetStatus (1);
  1655.                               SelectColor := CurrentColor;
  1656.                               end;
  1657.                             end;
  1658.  
  1659.           { Ctrl Left Arrow }
  1660.           ccUser15        : begin
  1661.                             DownCycle (CurrentColor, 0, 15);
  1662.                             ShowSelectedColor;
  1663.                             CueClick;
  1664.                             end;
  1665.  
  1666.           { Ctrl Right Arrow }
  1667.           ccUser16        : begin
  1668.                             UpCycle   (CurrentColor, 0, 15);
  1669.                             ShowSelectedColor;
  1670.                             CueClick;
  1671.                             end;
  1672.  
  1673.           { Ctrl Home }
  1674.           ccUser18        : begin;
  1675.                             if CurrentColor > 7 then
  1676.                               CurrentColor := CurrentColor - 8
  1677.                             else
  1678.                               CurrentColor := CurrentColor + 8;
  1679.                             ShowSelectedColor;
  1680.                             CueClick;
  1681.                             end;
  1682.  
  1683.           end;  { case }
  1684.  
  1685.         LastccUser := M.GetLastCommand;
  1686.         end;  { begin }
  1687.   until
  1688.     ExitFlag;
  1689.  
  1690.   DisableEventHandling;                          { no mousing allowed }
  1691.   FinalFadeOutProc := EndProc;                   { dispose objects }
  1692.  
  1693.   if                                             { if any defaults changed }
  1694.     (StoreSfxFlag <> SfxFlag) or
  1695.     (StoreMouseSpeed <> MouseSpeed) or
  1696.     (StoreDissolveDelay <> DissolveDelay)
  1697.   then                                           
  1698.     ResetDefaults;                               { reset default settings }
  1699. END;
  1700.  
  1701. { ========================================================================= }
  1702. { ========================================================================= }
  1703.